home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / BASIC / 0006.ZIP / SORTEST.BAS < prev    next >
BASIC Source File  |  1983-07-11  |  8KB  |  168 lines
  1. 10 'DRIVER PROGRAM FOR TESTING SORT ROUTINES
  2. 20 '
  3. 30 'PROGRAM BY: LEE M. BUCK, ARLINGTON, VA.
  4. 40 '
  5. 50 CLS: KEY OFF: SCREEN 0,0,0,0: WIDTH 80: COLOR 7,0,0
  6. 60 '
  7. 70 PRINT :PRINT "STRING SORTING DEMO - COPYRIGHT 1983 LEE M BUCK":PRINT
  8. 80 PRINT "THIS DEMO IS SET UP FOR A 64K MACHINE. IF YOU HAVE MORE MEMORY"
  9. 90 PRINT "  you may change line 280 to:  CLEAR ,65535!  from   CLEAR ,38900!"
  10. 100 PRINT "  and line 690 to:   MEM.SIZE=96   from   MEM.SIZE=64"
  11. 110 PRINT "THIS WILL ALLOW YOU TO USE ALL OF BASIC'S WORK SPACE."
  12. 120 PRINT :PRINT "THIS PROGRAM DEMONSTRATES THE ASSEMBLY LANGUAGE SORT MODULE"
  13. 130 PRINT "CONTAINED IN THE FILE 'SORT.BLD' - IT MUST BE ON THE DEFAULT DRIVE"
  14. 140 PRINT "BEFORE RUNNING THIS PROGRAM **NOTE** YOU DO NOT NEED THE ASSEMBLER!"
  15. 150 PRINT :PRINT "PLEASE READ THE FILE SORT.DOC FOR ADDITIONAL INFORMATION"
  16. 160 PRINT "ON THE ASSEMBLY LANGUAGE SUBROUTINE.  IF YOU HAVE QUESTIONS "
  17. 170 PRINT "YOU MAY CONTACT ME AT THE ADDRESS IN THE SORT.DOC FILE. STUDY THIS"
  18. 180 PRINT "DEMO PROGRAM LISTING FOR ADDITIONAL TIPS ON USING THE SUBROUTINE."
  19. 190 PRINT :PRINT "THIS PROGRAM OR ASSEMBLY LANGUAGE SORT MODULE IS NOT FOR SALE"
  20. 200 PRINT "WITHOUT WRITTEN CONSENT OF THE AUTHOR.  THEY ARE INTENDED FOR"
  21. 210 PRINT "FREE USE BY THE IBM PC USER COMMUNITY."
  22. 220 '
  23. 230 PRINT :PRINT "PRESS 'Esc' TO QUIT - SPACE BAR TO CONTINUE": BEEP
  24. 240 DEF SEG: POKE 106,0
  25. 250 Q$=INKEY$: IF Q$="" THEN 250 ELSE IF Q$=CHR$(27) THEN KEY ON: END
  26. 260 IF Q$<>CHR$(32) THEN 250
  27. 270 '
  28. 280 CLEAR ,38900!      'FOR 96K OR MORE CHANGE THIS TO  CLEAR ,65535!
  29. 290 DEFINT A-Z: NDIM=INT(FRE(0)/2400)*100    '**PICK YOUR OWN VALUE FOR NDIM
  30. 300 DIM PTR(NDIM),PTRD(NDIM)            '**IF YOU WANT MORE STRINGS
  31. 310 CLS: KEY OFF: FALSE=0: TRUE=NOT FALSE
  32. 320 '
  33. 330 '      ------------ convert time$ to sec and back  ---------
  34. 340 DEF FNSEC!(TM$)=VAL(LEFT$(TM$,2))*3600+VAL(MID$(TM$,4,2))*60+VAL(RIGHT$(TM$ ,2))
  35. 350 DEF FNTIM$(SC!)=RIGHT$(STR$(INT(SC!/3600)),2)+":"+RIGHT$(STR$(INT((SC!- 3600*(INT(SC!/3600)))/60)),2)+":"+RIGHT$(STR$(SC!-3600*(INT(SC!/3600))- 60*(INT((SC!-3600*(INT(SC!/3600)))/60))),2)
  36. 360 GOTO 760
  37. 370 '      ------------ elapsed time subroutine ---------
  38. 380 TSEC!=FNSEC!(TIME$)
  39. 390 TELP!=TSEC!-TSTRT!:IF TELP!<0! THEN TELP!=TSEC!+(86400!-TSTRT!)
  40. 400 RETURN
  41. 410 '      -------- end elapsed time subroutine ---------
  42. 420 '
  43. 430 '---------- SHELL METZNER SORT ----------
  44. 440 COLOR 23,0: LOCATE ,1: PRINT "working";
  45. 450 K1=N
  46. 460 K1=INT(K1/2): IF K1=0 THEN 530 ELSE BEEP: PRINT ".";  'SIGNAL IT'S ALIVE
  47. 470 K2=N-K1: J=1
  48. 480 I=J
  49. 490 K3=I+K1: IF A$(I) < A$(K3) THEN 510
  50. 500 SWAP A$(I),A$(K3): I=I-K1: IF I>=1 THEN 490
  51. 510 J=J+1: IF J>K2 THEN 460
  52. 520 GOTO 480
  53. 530 RETURN
  54. 540 '
  55. 550 ' METHOD OF CALCULATING SEGMENT ADDRESS FOR LOADING MACHINE LANGUAGE
  56. 560 ' IN MEMORY.  MEM.SIZE IS THE MACHINE MEMORY SIZE.  THE MODULE IS LOADED
  57. 570 ' BELOW THIS AREA.  MEM.SIZE IS EXPRESSED IN 'K'.  FOR EXAMPLE, ON A 320K
  58. 580 ' MACHINE USING A 160K RAM DISK THE HIGHEST LOCATION IS 160K.  MACHINE
  59. 590 ' LANGUAGE ROUTINES WILL BE LOADED JUST BELOW THIS.
  60. 600 ' PGM.SIZE IS THE SIZE OF THE MACHINE LANGUAGE MODULE.  IF YOU DIDN'T
  61. 610 ' WRITE THE MODULE YOU HAVE TO TAKE THE AUTHORS WORD FOR IT OR LOAD
  62. 620 ' IT WITH DEBUG TO DETERMINE THE SIZE.
  63. 630 ' THIS IS 'K' MEMORY TIMES 1024/16 MINUS NO. OF 16 BYTE BLOCKS FOR CODE
  64. 640 '
  65. 650 SEGMENT=MEM.SIZE*64 - CINT(PGM.SIZE/16)
  66. 660 RETURN
  67. 670 '
  68. 680 'LOAD THE ASM. LANGUAGE SORT MODULE INTO MEMORY ABOVE BASIC'S SPACE
  69. 690 MEM.SIZE=64       'HIGH AVAIL. MEMORY LOCATION IN 'K'(MACHINE DEPENDENT)
  70. 700 PGM.SIZE=&H200    'SIZE OF THE MACHINE LANGUAGE PROGRAM
  71. 710 GOSUB 550          'CALCULATE "SEGMENT" TO LOAD SORT MODULE
  72. 720 ON ERROR GOTO 1590
  73. 730 DEF SEG=SEGMENT: BLOAD "SORT.BLD",0
  74. 740 RETURN
  75. 750 '
  76. 760 GOSUB 680          'LOAD THE ASM. MODULE
  77. 770 '
  78. 780 DIM A$(NDIM),AS$(NDIM)
  79. 790 WHILE INKEY$<>"":WEND       'CLEAR KEYBOARD BUFFER
  80. 800 NDIM$=STR$(NDIM): NDIM$=RIGHT$(NDIM$,LEN(NDIM$)-1)
  81. 810 CLS: PRINT: SOUND 1000,1
  82. 820 PRINT "HOW MANY STRINGS DO YOU WANT TO SORT (";NDIM$;: INPUT " MAX)";N
  83. 830 IF N<1 THEN N=20          'DEFAULT TO 20
  84. 840 IF N<=NDIM THEN 850 ELSE BEEP: GOTO 820
  85. 850 SOUND 1000,1
  86. 860 PRINT "WHAT IS THE MAXIMUM STRING SIZE (255 MAX)"
  87. 870 INPUT "(FOR DISPLAY PURPOSES 13 OR LESS IS BEST)";NMAX
  88. 880 IF NMAX<1 THEN NMAX=1     'DEFAULT TO 1
  89. 890 IF NMAX>255 THEN BEEP: NMAX=255
  90. 900 PRINT
  91. 910 PRINT "HOLD ON WHILE I GENERATE ";N;" RANDOM STRINGS"
  92. 920 RANDOMIZE (VAL(MID$(TIME$,4,2))*60+VAL(RIGHT$(TIME$,2))): X!=FRE("")
  93. 930 '
  94. 940 PRINT :PRINT "GENERATING STRING";TAB(30);"BYTES FREE";: LOCATE ,18
  95. 950 FOR I=1 TO N
  96. 960 L=RND*NMAX: IF L<1 THEN L=1      'LENGTH
  97. 970 C=RND*60+63             'CHARACTER
  98. 980 IF (C>64 AND C<91) OR (C>96 AND C<123) THEN 990 ELSE 970
  99. 990 A$(I)=STRING$(L,C): AS$(I)=A$(I): PTR(I)=I: PTRD(I)=I
  100. 1000 PRINT USING "#####";I;:LOCATE ,41:PRINT USING "#####";FRE(0);:LOCATE ,18
  101. 1010 IF FRE(0)>500 THEN 1050
  102. 1020 SOUND 500,6:SOUND 1200,5:SOUND 600,6:SOUND 1000,5
  103. 1030 PRINT: PRINT "STOPPING AT";I;" STRINGS...MEMORY GETTING LOW": N=I
  104. 1040 FOR II=1 TO 1000:NEXT II: GOTO 1070
  105. 1050 NEXT: PRINT
  106. 1060 '
  107. 1070 ' DO THE INTERPRETED SHELL-METZNER SORT
  108. 1080 PRINT: PRINT "BEGINNING INTERPRETER BASIC SHELL-METZNER SORT"
  109. 1090 PRINT "This will take about";SPC(5);" minutes";
  110. 1100 LOCATE ,POS(0)-12: PRINT USING "##.#";(.0006*N^1.3)
  111. 1110 NDOTS=CINT(LOG(N)/LOG(2)+.5):LOCATE ,8+NDOTS
  112. 1120 PRINT CHR$(17);CHR$(205);" finished when dots get here";
  113. 1130 TSTRT!=FNSEC!(TIME$)
  114. 1140 GOSUB 430          'DO A SHELL-METZNER SORT - 'REM' THIS LINE FOR SPEED
  115. 1150 GOSUB 370           'CALCULATE ELAPSED TIME
  116. 1160 METZTIM$=FNTIM$(TELP!)
  117. 1170 COLOR 7,0: LOCATE ,1: PRINT SPACE$(50);: LOCATE ,1
  118. 1180 BEEP : PRINT "SHELL-METZNER TIME ";METZTIM$;" (hh:mm:ss)"
  119. 1190 '
  120. 1200 ' ASM SORT IN ASCENDING ORDER
  121. 1210 BEEP: PRINT: PRINT "BEGINNING ASSEMBLY LANGUAGE SHELL-METZ SORT UP"
  122. 1220 TSTRT!=FNSEC!(TIME$)
  123. 1230 DEF SEG=SEGMENT  'SET THE SEGMENT LOCATION
  124. 1240 SORTUP=0          'SET THE ENTRY POINT
  125. 1250 CALL SORTUP(AS$(1),PTR(1),N)
  126. 1260 GOSUB 370          'CALCULATE ELAPSED TIME
  127. 1270 ASSYTIM$=FNTIM$(TELP!)
  128. 1280 BEEP : PRINT "ASM SHELL-METZ TIME ";ASSYTIM$;" (hh:mm:ss)"
  129. 1290 '
  130. 1300 ' ASM SORT IN DESCENDING ORDER
  131. 1310 BEEP: PRINT: PRINT "BEGINNING ASSEMBLY LANGUAGE SHELL-METZ SORT DOWN"
  132. 1320 TSTRT!=FNSEC!(TIME$)
  133. 1330 DEF SEG=SEGMENT  'SET THE SEGMENT LOCATION
  134. 1340 SORTDN=2          'SET THE ENTRY POINT FOR DESCENDING SORT
  135. 1350 CALL SORTDN(AS$(1),PTRD(1),N)
  136. 1360 GOSUB 370          'CALCULATE ELAPSED TIME
  137. 1370 ASSYTIM$=FNTIM$(TELP!)
  138. 1380 BEEP : PRINT "ASM SHELL-METZ TIME ";ASSYTIM$;" (hh:mm:ss)"
  139. 1390 '
  140. 1400 ' PRINT THE RESULTS
  141. 1410 PRINT: INPUT "DO YOU WANT TO DISPLAY THE RESULT (Y/N)";Q$
  142. 1420 IF LEFT$(Q$,1)<>"Y" AND LEFT$(Q$,1)<>"y" THEN 1550
  143. 1430 INPUT "PRINT TO SCREEN OR PRINTER (S/P) ";Q$
  144. 1440 IF LEFT$(Q$,1)="S" OR LEFT$(Q$,1)="s" THEN SCRN=TRUE: GOTO 1470
  145. 1450 IF LEFT$(Q$,1)="P" OR LEFT$(Q$,1)="p" THEN PRNT=TRUE: GOTO 1470
  146. 1460 BEEP: GOTO 1430
  147. 1470 PRINT :PRINT
  148. 1480 IF SCRN THEN PRINT "ORIGINAL","INTERP S-M","ASM  UP","ASM  DN":PRINT
  149. 1490 IF PRNT THEN LPRINT "ORIGINAL","INTERP S-M","ASM  UP","ASM  DN":LPRINT
  150. 1500 FOR I=1 TO N
  151. 1510 IF SCRN THEN PRINT AS$(I),A$(I),AS$(PTR(I)),AS$(PTRD(I))
  152. 1520 IF SCRN THEN IF (I MOD 20) = 0 THEN FOR II=1 TO 800: NEXT II      'pause
  153. 1530 IF PRNT THEN LPRINT AS$(I),A$(I),AS$(PTR(I)),AS$(PTRD(I))
  154. 1540 NEXT I
  155. 1550 PRINT: BEEP: INPUT "Want to try another test (Y/N)";Q$
  156. 1560 IF LEFT$(Q$,1)<>"Y" AND LEFT$(Q$,1)<>"y" THEN 1580
  157. 1570 ERASE A$,AS$ : GOTO 780        'START AGAIN
  158. 1580 KEY ON: ON ERROR GOTO 0: BEEP: END
  159. 1590 '
  160. 1600 ' ERROR TRAP FOR MISSING SORT.BLD FILE
  161. 1610 IF ERR<>53 OR ERL<>730 THEN 1650
  162. 1620 PRINT "CHECK DEFAULT DRIVE FOR FILE NAMED SORT.BLD"
  163. 1630 PRINT "RUN SORTBLD.BAS TO CREATE IT IF NECESSARY"
  164. 1640 GOTO 1660
  165. 1650 PRINT "ERROR";ERR;" AT LINE";ERL;" ... UNRECOVERABLE ..."
  166. 1660 SOUND 400,20: SOUND 200,25
  167. 1670 GOTO 1580
  168.